World Inequality Report 2022

1 Introduction

1.1 WIR2022

• Executive Summary: https://wir2022.wid.world/executive-summary/
• Methodology: https://wir2022.wid.world/methodology/

2 Executive Summary

2.1 Setup

• Data: https://wir2022.wid.world/www-site/uploads/2022/03/WIR2022TablesFigures-Summary.xlsx
• Data are in Excel format and charts are also created in Excel.

library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      

── Attaching packages ────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
✔ tibble  3.1.8      ✔ dplyr   1.0.10
✔ tidyr   1.2.1      ✔ stringr 1.4.1 
✔ readr   2.1.3      ✔ forcats 0.5.2 
── Conflicts ───────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(readxl)

url_summary <- "https://wir2022.wid.world/www-site/uploads/2022/03/WIR2022TablesFigures-Summary.xlsx"
download.file(url = url_summary, destfile = "data/WIR2022TablesFigures-Summary.xlsx") 

summary_sheets <- excel_sheets("data/WIR2022TablesFigures-Summary.xlsx")
summary_sheets

 [1] "Index"     "F1"        "F2"        "F3"        "F4"       
 [6] "F5."       "F6"        "F7"        "F8"        "F9"       
[11] "F10"       "F11"       "F12"       "F13"       "F14"      
[16] "F15"       "T1"        "data-F1"   "data-F2"   "data-F3"  
[21] "data-F4"   "data-F5"   "data-F6"   "data-F7"   "data-F8"  
[26] "data-F9"   "data-F10"  "data-F11"  "data-F12"  "data-F13."
[31] "data-F14." "data-F15" 

• Note that some of the sheet names contain a period.

df_index <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "Index")
df_index

• The list of the titles of the tables and the figures.

2.2 Data and Charts

2.2.1 F1: Global income and wealth inequality, 2021

df_f1 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F1")

New names:
• `` -> `...1`

df_f1

df_f1 %>% select(cat = ...1, 2:4) %>%
  pivot_longer(2:4, names_to = "level", values_to = "value") %>%
  ggplot(aes(x = cat, y = value, fill = level)) +
  geom_col(position = "dodge") + 
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 1. Global income and wealth inequality, 2021",
       x = "", y = "Share of total income or wealth", fill = "")

Interpretation: The global bottom 50% captures 8.5% of total income measured at Purchasing Power Parity (PPP). The global bottom 50% owns 2% of wealth (at Purchasing Power Parity). The global top 10% owns 76% of total Household wealth and captures 52% of total income in 2021. Note that top wealth holders are not necessarily top income holders. Incomes are measured after the operation of pension and unemployment systems and before taxes and transfers.
Sources and series: wir2022.wid.world/methodology.

2.2.2 F2: The poorest half lags behind: Bottom 50%, middle 40% and top 10% income shares across the world in 2021

df_f2 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F2")
df_f2

df_f2 %>% pivot_longer(3:5, names_to = "level", values_to = "value") %>%
  ggplot(aes(x = iso, y = value, fill = level)) +
  geom_col(position = "dodge") + 
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 2. The poorest half lags behind", 
       subtitle = "Bottom 50%, middle 40% and top 10% income shares across the world in 2021",
       x = "", y = "Share of national income (%)", fill = "")

Interpretation: In Latin America, the top 10% captures 55% of national income, compared to 36% in Europe. Income is measured after pension and unemployment contributions and benefits paid and received by individuals but before income taxes and other transfers.
Sources and series: www.wir2022.wid.world/methodology.

df_f2 %>% pivot_longer(3:5, names_to = "level", values_to = "value") %>%
  ggplot(aes(x = iso, y = value, fill = level)) +
  geom_col(position = "dodge") + 
  theme(axis.text.x = element_text(angle = 30, vjust = 1, hjust=1)) + 
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 2. The poorest half lags behind", 
       subtitle = "Bottom 50%, middle 40% and top 10% income shares across the world in 2021",
       x = "", y = "Share of national income (%)", fill = "")

2.2.3 F3: Top 10/Bottom 50 income gaps across the world, 2021

df_f3 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F3")
df_f3

2.2.4 F4: The extreme concentration of capital: wealth inequality across the world, 2021

df_f4 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F4")
df_f4

• Wrap long label: scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10))
• Per Cent: scale_y_continuous(labels = scales::percent_format(accuracy = 1))

df_f4 %>% pivot_longer(3:5, names_to = "level", values_to = "value") %>%
  ggplot(aes(x = iso, y = value, fill = level)) +
  geom_col(position = "dodge") + 
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 4. The extreme concentration of capital:", 
       subtitle = "wealth inequality across the world, 2021",
       x = "", y = "Share of national wealth (%)", fill = "")

Interpretation: The Top 10% in Latin America captures 77% of total household wealth, versus 22% for the Middle 40% and 1% for the Bottom 50%. In Europe, the Top 10% owns 58% of total wealth, versus 38% for the Middle 40% and 4% for the Bottom 50%.
Sources and series: wir2022.wid.world/methodology.

2.2.5 F5: Global income inequality: T10/B50 ratio, 1820-2020

df_f5 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F5")
df_f5

Use span Argument to Fit to Data

• y-axis: lims(y = c(10,70))
• stringr::str_wrap("long text", width = size)
• annotate with size = fontsize

df_f5 %>% select(year = y, ratio = t10b50) %>%
  ggplot(aes(x = year, y = ratio)) + 
  lims(y = c(10,70)) + 
  stat_smooth(span = 0.25, se = FALSE) + 
  scale_x_continuous(breaks = round(seq(1820, 2020, by = 20),1)) + 
  labs(title = "Figure 5. Global income inequality:T10/B50 ratio, 1820-2020", 
       x = "", y = stringr::str_wrap("Ratio of top 10% average income to bottom 50% average income", width = 35)) +
  annotate("text", x = 1840, y = 32, label = stringr::str_wrap("1820: average income of the global top 10% is 18x higher than average income of the bottom 50%", width = 20), size = 3) + 
  annotate("text", x = 1910, y = 49, label = stringr::str_wrap("1910: average income of the global top 10% is 41x higher than average income of the bottom 50%", width = 20), size = 3) +
    annotate("text", x = 1980, y = 60, label = stringr::str_wrap("1980: average income of the global top 10% is 53x higher than average income of the bottom 50%", width = 20), size = 3) +
    annotate("text", x = 2010, y = 32, label = stringr::str_wrap("2020: average income of the global top 10% is 38x higher than average income of the bottom 50%", width = 20), size = 3)

`geom_smooth()` using method = 'loess' and formula 'y ~ x'

Interpretation. Global inequality, as measured by the ratio T10/B50 between the average income of the top 10% and the average income of the bottom 50%, more than doubled between between 1820 and 1910, from less than 20 to about 40, and stabilized around 40 between 1910 and 2020. It is too early to say whether the decline in global inequality observed since 2008 will continue. Income is measured per capita after pension and unemployement insurance transfers and before income and wealth taxes.
Sources and series: wir2022.wid.world/lmethodology and Chancel and Piketty (2021)..

• ggforce::geom_mark_rect will add annotation in a box.

Line Plot and LOESS

df_f5 %>% select(year = y, ratio = t10b50) %>%
  ggplot(aes(x = year, y = ratio)) +
  geom_line() +
  geom_smooth(method = "loess", se = FALSE) + 
  labs(title = "Figure 5. Global income inequality:", 
       subtitle = "T10/B50 ratio, 1820-2020",
       x = "", y = "Ratio of top 10% average income to bottom 50% average income")

`geom_smooth()` using formula 'y ~ x'

GAM Smoothing with 24 Points

df_f5 %>% select(year = y, ratio = t10b50) %>%
  ggplot(aes(x = year, y = ratio)) +
  stat_smooth(method = "gam", formula = y ~ s(x, k = 24), se = FALSE) + 
  scale_x_continuous(breaks = round(seq(min(df_f5$y), max(df_f5$y), by = 20),1)) + 
  labs(title = "Figure 5. Global income inequality:T10/B50 ratio, 1820-2020", 
       x = "", y = stringr::str_wrap("Ratio of top 10% average income to bottom 50% average income", width = 35))

Polynomial Approximation of Degree 6

df_f5 %>% select(year = y, ratio = t10b50) %>%
  ggplot(aes(x = year, y = ratio)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ poly(x, 6), se = FALSE) + 
  labs(title = "Figure 5. Global income inequality:", 
       subtitle = "T10/B50 ratio, 1820-2020",
       x = "", y = "Ratio of top 10% average income to bottom 50% average income")

2.2.6 F6: Global income inequality: Between vs. Within country inequality (Theil index), 1820-2020

df_f6 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F6")

New names:
• `` -> `...1`

df_f6

• rev(scales::hue_pal()(2)): reversing the order of colors to fill.

df_f6 %>% select(year = "...1", 2:3) %>%
  pivot_longer(cols = 2:3, names_to = "type", values_to = "value") %>%
  mutate(types = factor(type, levels = c("Within-country inequality", "Between-country inequality"))) %>%
  ggplot(aes(x = year, y = value, fill = types)) +
  geom_area() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = round(seq(1820, 2020, by = 20),1)) + 
  scale_fill_manual(values=rev(scales::hue_pal()(2)), labels = function(x) str_wrap(x, width = 15)) +
  labs(title = "Figure 6. Global income inequality:", 
       subtitle = "Between vs. within country inequality (Theil index), 1820-2020",
       x = "", y = "Share of global inequality (% of total Theil index)", fill = "") + 
  annotate("text", x = 1850, y = 0.28, label = stringr::str_wrap("1820: Between country inequality represents 11% of global inequality", width = 20), size = 3) + 
  annotate("text", x = 1980, y = 0.70, label = stringr::str_wrap("1980: Between country inequality represents 57% of global inequality", width = 20), size = 3) +
    annotate("text", x = 1990, y = 0.30, label = stringr::str_wrap("2020: Between country inequality represents 32% of global inequality", width = 20), size = 3)

• Legend can be place at the bottom: theme(legend.position="bottom")

df_f6 %>% select(year = "...1", 2:3) %>%
  pivot_longer(cols = 2:3, names_to = "type", values_to = "value") %>%
  mutate(types = factor(type, levels = c("Within-country inequality", "Between-country inequality"))) %>%
  ggplot(aes(x = year, y = value, fill = types)) +
  geom_area() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = round(seq(1820, 2020, by = 20),1)) + 
  scale_fill_manual(values=rev(scales::hue_pal()(2))) +
  labs(title = "Figure 6. Global income inequality:", 
       subtitle = "Between vs. within country inequality (Theil index), 1820-2020",
       x = "", y = "Share of global inequality (% of total Theil index)", fill = "") + 
  annotate("text", x = 1850, y = 0.28, label = stringr::str_wrap("1820: Between country inequality represents 11% of global inequality", width = 20), size = 3) + 
  annotate("text", x = 1980, y = 0.70, label = stringr::str_wrap("1980: Between country inequality represents 57% of global inequality", width = 20), size = 3) +
    annotate("text", x = 1990, y = 0.30, label = stringr::str_wrap("2020: Between country inequality represents 32% of global inequality", width = 20), size = 3) +
  theme(legend.position="bottom")

Interpretation. The importance of between-country inequality in overall global inequality, as measured by the Theil index, rose between 1820 and 1980 and strongly declined since then. In 2020, between-country inequality makes-up about a third of global inequality between individuals. The rest is due to inequality within countries. Income is measured per capita after pension and unemployement insurance transfers and before income and wealth taxes.
Sources and series: wir2022.wid.world/methodology and Chancel and Piketty (2021).

df_f6 %>% select(year = "...1", 2:3) %>%
  pivot_longer(cols = 2:3, names_to = "type", values_to = "value") %>%
  ggplot(aes(x = year, y = value, fill = type)) +
  geom_area() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 6. Global income inequality:", 
       subtitle = "Between vs. within country inequality (Theil index), 1820-2020",
       x = "", y = "Share of global inequality (% of total Theil index)")

2.2.7 F7: Global income inequality, 1820-2020

df_f7 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F7")
df_f7

df_f7 %>% select(year = y, 2:4) %>%
  pivot_longer(cols = 2:4, names_to = "type", values_to = "value") %>%
  ggplot(aes(x = year, y = value, color = type)) +
  stat_smooth(span = 0.25, se = FALSE) +
  scale_x_continuous(breaks = round(seq(1820, 2020, by = 20),1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 7. Global income inequality, 1820-2020", 
       x = "", y = " Share of total world income (%)", color = "") +
  annotate("text", x = 1980, y = 0.20, label = stringr::str_wrap("The global bottom 50% income share remains historically low despite growth in the emerging world in the past decades.", width = 30), size = 3)

`geom_smooth()` using method = 'loess' and formula 'y ~ x'

Interpretation. The share of global income going to top 10% highest incomes at the world level has fluctuated around 50-60% between 1820 and 2020 (50% in 1820, 60% in 1910, 56% in 1980, 61% in 2000, 55% in 2020), while the share going to the bottom 50% lowest incomes has generally been around or below 10% (14% in 1820, 7% in 1910, 5% in 1980, 6% in 2000, 7% in 2020). Global inequality has always been very large. It rose between 1820 and 1910 and shows little long-run trend between 1910 and 2020. Distribution of per capita incomes. Sources and series: see wir2022.wid.world/methodology and Chancel and Piketty (2021).

2.2.8 F8: The rise of private versus the decline of public wealth in rich countries, 1970-2020

df_f8 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F8")
df_f8

df_f8 %>% 
  pivot_longer(!year, names_to = "group", values_to = "value") %>%
  ggplot() +
  stat_smooth(aes(x = year, y = value, color = group), span = 0.25, se = FALSE, size=0.75) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 8. The rise of private versus the decline of public wealth in rich countries, 1970-2020", 
       x = "", y = "wealth as as % of national income", color = "")

`geom_smooth()` using method = 'loess' and formula 'y ~ x'
 警告:  Removed 50 rows containing non-finite values (stat_smooth).

Interpretation: Public wealth is the sum of all financial and non-financial assets, net of debts, held by governments. Public wealth dropped from 60% of national income in 1970 to -106% in 2020 in the UK. Sources and series: wir2022.wid.world/methodology, Bauluz et al. (2021) and updates.

2.2.9 F9: Average annual wealth growth rate, 1995-2021

df_f9 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F9")
df_f9

df_f9 %>% select(p, wealth = 'Wealth growth 1995-2021') %>%
  ggplot() +
  stat_smooth(aes(x = p, y = wealth), span = 0.25, se = FALSE) +
#  scale_x_continuous(breaks = round(c(seq(0, 90, by = 10), 99.9, 99.99, 99.999,3))) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 9. Average annual wealth growth rate, 1995-2021", 
       x = "←1% poorest                               Global wealth group                                 0.001% richest→", y = "Per adult annual growth rate in wealth, net of inflation (%)", color = "")

`geom_smooth()` using method = 'loess' and formula 'y ~ x'

Interpretation: Growth rates among the poorest half of the population were between 3% and 4% per year, between 1995 and 2021. Since this group started from very low wealth levels, its absolute levels of growth remained very low. The poorest half of the world population only captured 2.3% of overall wealth growth since 1995. The top 1% benefited from high growth rates (3% to 9% per year). This group captured 38% of total wealth growth between 1995 and 2021. Net household wealth is equal to the sum of financial assets (e.g. equity or bonds) and non-financial assets (e.g. housing or land) owned by individuals, net of their debts.
Sources and series: wir2022.wid.world/methodology.

2.2.10 F10: The share of wealth owned by the global 0.1% and billionaires, 2021

df_f10 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F10")

New names:
• `` -> `...4`
• `` -> `...5`
• `` -> `...6`

df_f10

df_f10 %>% 
  select(year, "Global Billionaire Wealth" = bn_hhweal, "Top 0.01%" = top0.1_hhweal) %>%
  pivot_longer(!year, names_to = "group",".value", values_to = "value") %>%
  ggplot() +
  stat_smooth(aes(x = year, y = value, color = group), span = 0.25, se = FALSE) +
  scale_x_continuous(breaks = round(seq(1995, 2020, by = 5),1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_color_manual(values=rev(scales::hue_pal()(2))) +
  labs(title = "Figure 10. Extreme wealth inequality: \nthe rise of global billionaires and top 0.01%, 1995-2021", 
       x = "", y = "Share of total household wealth (%)", color = "")

`geom_smooth()` using method = 'loess' and formula 'y ~ x'

Interpretation: The share of wealth detained by the world’s billionaires rose from 1% of total household wealth in 1995 to nearly 3.5% today. The threshold of top 0.01%, composed of 520 000 adults, grew from €693,000 (PPP) in 1995 to €16,666,000 today. The net household wealth is equal to the sum of financial assets (e.g. equity or bonds) and non-financial assets (e.g. housing or land) owned by individuals, net of their debts.
Sources and series: wir2022.wid.world/methodology, Bauluz et al. (2021) and updates.

2.2.11 F11: Top 1% vs bottom 50% wealth shares in Western Europe and the US, 1910-2020

df_f11 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F11")
df_f11

df_f11 %>% 
  rename(!year, US_bot50 = USbot50, US_top1 = UStop1, EU_bot50 = EUbot50, EU_top1 = EUtop1) %>%
  pivot_longer(!year, names_to = c("group",".value"), names_sep = "_") %>%
  ggplot() +
  stat_smooth(aes(x = year, y = top1, color = group), span = 0.25, se = FALSE) +
  stat_smooth(aes(x = year, y = bot50, color = group), span = 0.25, se = FALSE, linetype = 2) +
  scale_x_continuous(breaks = round(seq(1910, 2020, by = 10),1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 11. Top 1% vs bottom 50% wealth shares \n in Western Europe and the US, 1910-2020", 
       x = "", y = "Share of total personal wealth (%)", color = "") +
  annotate("text", x = 2000, y = 0.50, label = stringr::str_wrap("Wealth inequality has been rising at different speeds after a historical decline. The bottom 50% has always been extremely low.", width = 30), size = 3)

`geom_smooth()` using method = 'loess' and formula 'y ~ x'
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
`geom_smooth()` using method = 'loess' and formula 'y ~ x'
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3

Interpretation: The graph presents decennal averages of top 1% personal wealth shares in Western Europe and the US. Between 1910 and 2020, the top 1% was 55% on average in Europe vs. 43% in the US. A century later, the US is almost back to its early 20th century level. Sources and series: wir2022.wid.world/methodology.

df_f11 %>% 
  rename(!year, US_bot50 = USbot50, US_top1 = UStop1, EU_bot50 = EUbot50, EU_top1 = EUtop1) %>%
  pivot_longer(!year, names_to = c("group",".value"), names_sep = "_") %>%
  pivot_longer(3:4, names_to = "type", values_to = "value") %>%
  ggplot() +
  stat_smooth(aes(x = year, y = value, color = group, linetype = type), span = 0.25, se = FALSE) +
  scale_x_continuous(breaks = round(seq(1910, 2020, by = 10),1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 11. Top 1% vs bottom 50% wealth shares \n in Western Europe and the US, 1910-2020", 
       x = "", y = "Share of total personal wealth (%)", color = "", linetype = "") +
  annotate("text", x = 2000, y = 0.50, label = stringr::str_wrap("Wealth inequality has been rising at different speeds after a historical decline. The bottom 50% has always been extremely low.", width = 30), size = 3)

`geom_smooth()` using method = 'loess' and formula 'y ~ x'
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3

df_f11 %>% 
  rename(!year, US_bot50 = USbot50, US_top1 = UStop1, EU_bot50 = EUbot50, EU_top1 = EUtop1) %>%
  pivot_longer(!year, names_to = c("group",".value"), names_sep = "_") %>%
  pivot_longer(3:4, names_to = "type", values_to = "value") %>%
  ggplot() +
  stat_smooth(aes(x = year, y = value, color = group, linetype = type), span = 0.25, se = FALSE) +
  scale_x_continuous(breaks = round(seq(1910, 2020, by = 10),1)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 11. Top 1% vs bottom 50% wealth shares \n in Western Europe and the US, 1910-2020", 
       x = "", y = "Share of total personal wealth (%)", color = "", linetype = "") +
  scale_linetype_manual(values = c("dotted","solid")) +
  annotate("text", x = 2000, y = 0.50, label = stringr::str_wrap("Wealth inequality has been rising at different speeds after a historical decline. The bottom 50% has always been extremely low.", width = 30), size = 3)

`geom_smooth()` using method = 'loess' and formula 'y ~ x'
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  span too small.   fewer data values than degrees of freedom.
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  pseudoinverse used at 1909.5
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  neighborhood radius 20.55
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  reciprocal condition number  0
 simpleLoess(y, x, w, span, degree = degree, parametric = parametric,  で警告がありました: 
  There are other near singularities as well. 422.3

2.2.12 F12: Female share in global labor incomes, 1990-2020

df_f12 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F12")

New names:
• `` -> `...2`

df_f12

df_f12 %>% 
  select(year = "Data needs to be updated", value = ...2) %>%
  filter(!is.na(year)) %>%
  ggplot(aes(x = year, y = value)) +
  geom_col(width = 0.5, fill = "blue") +
  geom_hline(yintercept = 0.5, linetype = 2, colour = "red") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 12. Female share in global labor incomes, 1990-2020", 
        x = "", y = "") +
  annotate("text", x = 1, y = 0.48, label = "Gender parity", size = 3) +
  annotate("text", x = 5.2, y = 0.47, label = stringr::str_wrap("Women make only 35% of global labor incomes, men make the remaining  65%.", width = 40), size = 3)

Interpretation: The share of female incomes in global labour incomes was 31% in 1990 and nears 35% in 2015-2020. Today, males make up 65% of total labor incomes. Sources and series: wir2022.wid.world/methodology and Neef and Robilliard (2021).

2.2.13 F13: Female labor income share across the world, 1990-2020

Note that the sheet name of F13 has period at the end. Note that summary_sheets[30] =data-F13. with a period.

df_f13 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F13.")

New names:
• `` -> `...1`

df_f13

df_f13 %>% pivot_longer(2:9, names_to = "region", values_to = "value") %>%
  ggplot(aes(x = region, y = value, fill = ...1)) +
  geom_col(position = "dodge") + 
  geom_hline(yintercept = 0.5, linetype = 2, colour = "red") +
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 12)) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 13. Female labor income share across the world, 1990-2020", 
        x = "", y = "", fill = "") +
  annotate("text", x = 1.2, y = 0.48, label = "Gender parity", size = 3)

Interpretation: The female labour income share rose from 34% to 38% in North America between 1990 and 2020. Sources and series: wir2022.wid.world/methodology and Neef and Robilliard (2021).

2.2.14 F14: Global carbon inequality, 2019. Group contribution to world emissions (%)

Note that the sheet name of F14 has period at the end. Note that summary_sheets[31] =data-F14. with a period.

df_f14 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F14.")
df_f14

• \n for line break in the title.

df_f14 %>% 
  ggplot(aes(x = Group, y = Share)) +
  geom_col(width = 0.5, fill = "blue") + 
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(title = "Figure 14. Global carbon inequality, \n2019 Group contribution to world emissions (%)", 
       x = "", y = "Share of world emissions (%)")

Interpretation: Personal carbon footprints include emissions from domestic consumption, public and private investments as well as imports and exports of carbon embedded in goods and services traded with the rest of the world. Modeled estimates based on the systematic combination of tax data, household surveys and input-output tables. Emissions split equally within households. Sources and series: wir2022.wid.world/methodology and Chancel (2021).

2.2.15 F15: Per capita emissions acriss the world, 2019

df_f15 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", sheet = "data-F15")
df_f15

df_f15 %>% mutate(region = rep(regionWID[!is.na(regionWID)], each = 3)) %>%
  select(region, group, tcap) %>%
  ggplot(aes(x = region, y = tcap, fill = group)) +
  geom_col(position = "dodge") + 
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  labs(title = "Figure 15 Per capita emissions across the world, 2019", 
       x = "", y = "tonnes of CO2e per person per year", fill = "")

Interpretation: Personal carbon footprints include emissions from domestic consumption, public and private investments as well as imports and exports of carbon embedded in goods and services traded with the rest of the world. Modeled estimates based on the systematic combination of tax data, household surveys and input-output tables. Emissions split equally within households. Sources and series: wir2022.wid.world/methodology and Chancel (2021).

region_test <- rep(df_f15$regionWID[!is.na(df_f15$regionWID)], each = 3)
region_test

 [1] "East Asia"               "East Asia"               "East Asia"              
 [4] "Europe"                  "Europe"                  "Europe"                 
 [7] "North America"           "North America"           "North America"          
[10] "South & South-East Asia" "South & South-East Asia" "South & South-East Asia"
[13] "Russia & Central Asia"   "Russia & Central Asia"   "Russia & Central Asia"  
[16] "MENA"                    "MENA"                    "MENA"                   
[19] "Latin America"           "Latin America"           "Latin America"          
[22] "Sub-Saharan Africa"      "Sub-Saharan Africa"      "Sub-Saharan Africa"     

2.2.16 T1 Global millionaires and billionaires, 2021

Check the format of the sheet and add skip=4, n_max=7.

df_t1 <- read_excel("data/WIR2022TablesFigures-Summary.xlsx", 
                    sheet = "T1", skip = 4, n_max = 7)
df_t1

Interpretation: In 2021, there were 62.2 million people in the world owning more than $1 million (measured at Market Exchange Rates). Their average wealth was $ 2.8 million, representing a total of $174 trillion. In our Tax scenario 2, a global progressive wealth tax would yield 2.1% of global income, taking into account capital depreciation and evasion. Sources and series: wir2022.wid.world/methodology.